library(spotifyr)
library(compmus)
library(tidyverse)
library(circlize)
library(DT)Week 8: Adding Features
This Week
- Sign up for presentations (see the link on Canvas)
- Remaining Important Dates:
- Today: Adding more features and discussing final project a bit.
- Wednesday: Timbre and Form
- Friday: First draft due
- This is a complete (roughly 10-12 page) draft.
- Next Monday and Tuesday: Individual meetings (first draft.)
- Next Wednesday: Presentation Day 1
- Monday (Week 10): No class; memorial day
- Wednesday (Week 10): Presentation Day 2
How shall we assess ourselves?
Draft
Paper
Presentation
Already Available Features
Global features of interest
Metadata we’ve been using
- artist_name
- album_release_date
- album_release_year
- album_release_date_precision
- available_markets
- track_name
- album_name
Continuous Variables
- danceability
- energy
- loudness
- speechiness
- acousticness
- instrumentalness
- liveness
- valence
- tempo
- duration_ms
- key_confidence
- mode_confidence
- time_signature_confidence
- tempo_confidence
- start_of_fadeout
- end_of_fadeout
- duration
Continuous Variables from Lyrics
- TF-IDF
- Sentiment analysis ()
Categorical Variables
- mode
- explicit
- key
- key_name
- mode_name
- key_mode
- time_signature
Additional Features We Might Explore
- Relationship to the broader key profile
- Transition probabilities
- Timbral markers
Relationship to the Broader Key Profile
One way of exploring a piece is by looking at how it fits within a broader key profile. For example, if we have one key profile taken from a large collection, how does a specific piece relate to that collection in terms of pitch content?
Here, we can start by getting a key profile of a playlist.
grab_playlist_info <- function(uri){
get_playlist_audio_features("", uri) |>
add_audio_analysis()
}
playlist <- grab_playlist_info("37i9dQZF1DX1kCIzMYtzum") Then we can grab chroma and pitches with code from earlier in the quarter (provided by Burgoyne examples):
get_pitch_list <- function(input){
##burgoyne's comp_mus code for gathering key profiles from chroma.
input |>
mutate(segments = map2(segments, key, compmus_c_transpose)) |>
select(segments) |>
unnest(segments) |>
select(start, duration, pitches) |>
mutate(pitches = map(pitches, compmus_normalise, "euclidean")) |>
compmus_gather_chroma() |>
group_by(pitch_class) |>
summarise(mean_value = mean(value))
}Then we just need to grab each list, and provide a pitch correlation (here I’ve used a loop, which might not be the most efficient way to do it in R).
pitch_list <- get_pitch_list(playlist)
playlist$pitch_cor <- NA
for(i in 1:nrow(playlist)){
pitch <- get_pitch_list(playlist[i,])
playlist$pitch_cor[i] <- cor(pitch$mean_value, pitch_list$mean_value)
}Exercise
- Can you grab a collection, and then look at how each piece in that collection relates to the broader key profile?
Transition Probabilities
We could also grab transition probabilities from note to note. Here we use previously used code to get chroma that go from one to another.
chroma_names <- c("C", "C#|Db","D", "D#|Eb", "E", "F", "F#|Gb","G", "G#|Ab","A", "A#|Bb","B" )
x <- playlist |>
mutate(segments = map2(segments, key, compmus_c_transpose)) |>
select(segments) |>
unnest(segments) |>
select(start, duration, pitches) |>
unnest(cols = pitches)
x$chroma <- rep(chroma_names, nrow(x)/12)
x <- x |>
filter(pitches == 1) |>
mutate(chroma2 = lead(chroma))
x |> select(chroma, chroma2) |> table() |> heatmap(Rowv = NA,
Colv = NA)
We might also want to run it as proportions, rather than raw counts:
pairs <- x |> select(chroma, chroma2) |> table()
prop.table(pairs) |> heatmap(Rowv = NA,
Colv = NA)
We can convert this data to rows and columns like this, and can then move toward adding it to the dataset.
grab_pitch_pairs <- function(input){
x <- input |>
mutate(segments = map2(segments, key, compmus_c_transpose)) |>
select(segments) |>
unnest(segments) |>
select(start, duration, pitches) |>
unnest(cols = pitches)
x$chroma <- rep(chroma_names, nrow(x)/12)
x <- x |>
filter(pitches == 1) |>
mutate(chroma2 = lead(chroma))
pair_proportion <- prop.table(pairs)
pair_proportion <- as.matrix(pair_proportion)
# melt the data.frame
df <- reshape2::melt(pair_proportion, na.rm = TRUE)
df$combined <- paste0(df$chroma,"-",df$chroma2)
df$combined <- as.factor(df$combined)
df <- as_tibble(df)
y <- df |> select(value, combined)
print(y)
}This is how we’d get the transitions from each pitch:
n <- grab_pitch_pairs(playlist) # A tibble: 144 × 2
value combined
<dbl> <fct>
1 0.0170 A-A
2 0.00353 A#|Bb-A
3 0.00314 B-A
4 0.00838 C-A
5 0.00108 C#|Db-A
6 0.00301 D-A
7 0.00217 D#|Eb-A
8 0.00369 E-A
9 0.00322 F-A
10 0.00174 F#|Gb-A
# ℹ 134 more rows
And we can pivot it to a table format with pivot_wide.
n |> pivot_wider(names_from = combined, values_from = value)# A tibble: 1 × 144
`A-A` `A#|Bb-A` `B-A` `C-A` `C#|Db-A` `D-A` `D#|Eb-A` `E-A` `F-A`
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 0.0170 0.00353 0.00314 0.00838 0.00108 0.00301 0.00217 0.00369 0.00322
# ℹ 135 more variables: `F#|Gb-A` <dbl>, `G-A` <dbl>, `G#|Ab-A` <dbl>,
# `A-A#|Bb` <dbl>, `A#|Bb-A#|Bb` <dbl>, `B-A#|Bb` <dbl>, `C-A#|Bb` <dbl>,
# `C#|Db-A#|Bb` <dbl>, `D-A#|Bb` <dbl>, `D#|Eb-A#|Bb` <dbl>, `E-A#|Bb` <dbl>,
# `F-A#|Bb` <dbl>, `F#|Gb-A#|Bb` <dbl>, `G-A#|Bb` <dbl>, `G#|Ab-A#|Bb` <dbl>,
# `A-B` <dbl>, `A#|Bb-B` <dbl>, `B-B` <dbl>, `C-B` <dbl>, `C#|Db-B` <dbl>,
# `D-B` <dbl>, `D#|Eb-B` <dbl>, `E-B` <dbl>, `F-B` <dbl>, `F#|Gb-B` <dbl>,
# `G-B` <dbl>, `G#|Ab-B` <dbl>, `A-C` <dbl>, `A#|Bb-C` <dbl>, `B-C` <dbl>, …
We can put all of this together like so (using the playlist variable from before.)
chroma_names <- c("C", "C#|Db","D", "D#|Eb", "E", "F", "F#|Gb","G", "G#|Ab","A", "A#|Bb","B" )
x <- playlist |>
mutate(segments = map2(segments, key, compmus_c_transpose)) |>
select(segments, track.name) |>
unnest(segments) |>
select(track.name, start, duration, pitches) |>
unnest(cols = pitches)
x$chroma <- rep(chroma_names, nrow(x)/12)
x <- x |>
filter(pitches == 1) |>
mutate(chroma2 = lead(chroma)) |>
select(track.name, chroma, chroma2)
new_df <- x |>
group_by(track.name) |>
select(-track.name) |>
table() |>
prop.table() |>
data.frame() |>
tibble() |>
mutate(bigram = paste(chroma, "to ", chroma2)) |>
select(track.name, Freq, bigram) |>
pivot_wider(names_from = bigram, values_from = Freq)Adding missing grouping variables: `track.name`
df <- cbind(playlist, new_df)We can display this beast of a table like so.
df |> datatable(filter = "top")Warning in instance$preRenderHook(instance): It seems your data is too big for
client-side DataTables. You may consider server-side processing:
https://rstudio.github.io/DT/server.html